home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap01 / howto01 / delphi10 / ccscreen.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-08-19  |  12.0 KB  |  278 lines
  1. unit Ccscreen;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls;
  8.  
  9. const
  10.  
  11.   CCSaverJumpIncrement = 5; { This controls the speed of bitmap motion }
  12.                             { 1=crawl; 10+=jerky                       }
  13. type
  14.   TCCScreenSaverForm = class(TForm)
  15.     CCSSTImer: TTimer;
  16.     procedure FormShow(Sender: TObject);
  17.     procedure FormHide(Sender: TObject);
  18.     procedure FormActivate(Sender: TObject);
  19.     procedure CCSSTImerTimer(Sender: TObject);
  20.   private
  21.     { Private declarations }
  22.   public
  23.     { Public declarations }
  24.     CurrentXLocation ,            { Position of the bitmap onscreen X }
  25.     CurrentYLocation ,            { Position of the bitmap onscreen Y }
  26.     CurrentDeltaX ,               { Amount to move left or right (-x) }
  27.     CurrentDeltaY : Integer;      { Amount to move up or down (-y)    }
  28.     TheDisplayBitmap : TBitmap;    { Bitmap to use in the saver        }
  29.     TheSavedBackgroundBitmap ,    { Portion of BgBMP saved each time  }
  30.     TheWorkSpaceBitmap : TBitmap; { Offscreen workspace to avoid flikr}
  31.     procedure ShutDownTheScreenSaver( var Msg : TMsg;
  32.      var Handled : boolean );            { This handles checking to shut down }
  33.   end;
  34.  
  35. var
  36.   CCScreenSaverForm: TCCScreenSaverForm;
  37.   StartingMousePosition : TPoint;    { This is where the mouse is when saver invoked }
  38. implementation
  39.  
  40. {$R *.DFM}
  41.  
  42. uses
  43.   Ccsavrsu, { This is the setup unit; used if /c in paramaters at startup }
  44.   CCErrors; { This is the custom error handling unit.                     }
  45.  
  46. { This procedure is used to check any incoming message for a keyboard/mouse }
  47. { event; if one is found the saver is deactivated; otherwise the message is }
  48. { passed through.                                                           }
  49. procedure TCCScreenSaverForm.ShutDownTheScreenSaver(var Msg : TMsg; var Handled : boolean);
  50. var
  51.   Finished : boolean; { This is a flag to tell whether to quit }
  52. begin
  53.   { Assume the saver will continue to run }
  54.   Finished := false;
  55.   { If the mouse is moved more than 5 pixels from start then kill the saver }
  56.   if Msg.message = WM_MOUSEMOVE then
  57.   begin
  58.     { Obtain an absolute value of difference between X and Y positions }
  59.     { which are in the Lo and Hi parameter words respectively.         }
  60.     if ( Abs( LoWord( Msg.lParam ) - StartingMousePosition.X ) > 5 ) then
  61.      Finished := true;
  62.     if ( Abs( HiWord( Msg.lParam ) - StartingMousePosition.Y ) > 5 ) then
  63.      Finished := true;
  64.   end
  65.   else
  66.   begin
  67.     { Check for a plethora of possible keyboard/mousebutton event messages }
  68.     case Msg.message of
  69.       WM_ACTIVATE    : Finished := true;
  70.       WM_ACTIVATEAPP : Finished := true;
  71.       WM_KEYDOWN     : Finished := true;
  72.       WM_KEYUP       : Finished := true;
  73.       WM_LBUTTONDOWN : Finished := true;
  74.       WM_MBUTTONDOWN : Finished := true;
  75.       WM_NCACTIVATE  : Finished := true;
  76.       WM_RBUTTONDOWN : Finished := true;
  77.       WM_SYSKEYDOWN  : Finished := true;
  78.       WM_SYSKEYUP    : Finished := true;
  79.     end;
  80.   end;
  81.   { If any appropriate message found kill the screen saver! }
  82.   if Finished then Close;
  83. end;
  84.  
  85. { This code is written by Delphi; put in the calls to set up the starting }
  86. { mouse position, the speed of the bitmap motion, and the starting bitmap }
  87. { coordinates chosen randomly. Also set up the message hook and hide the  }
  88. { cursor for neatness sake. Finally, get the necessary canvases to show   }
  89. { the moving bitmap smoothly. Last, load the bitmap to use as an image!   }
  90. procedure TCCScreenSaverForm.FormShow(Sender: TObject);
  91. begin
  92.   { Seed the random number generator }
  93.   Randomize;
  94.   { Use an API call to get the position of the mouse cursor at startup }
  95.   GetCursorPos( StartingMousePosition );
  96.   { Set the speed to move the bitmaap between 910 and 100 ms }
  97.   CCSSTimer.Interval := 305 -  ( SetupDialog.TheImageSpeed * 3 );
  98.   { Start the timer }
  99.   CCSSTimer.Enabled := true;
  100.   { Hook the message processing call into the Application object }
  101.   Application.OnMessage := ShutDownTheScreenSaver;
  102.   { Use an API call to hide the cursor for neatness! }
  103.   ShowCursor( false );
  104.   TheDisplayBitmap := TBitmap.Create;
  105.   { Load the image file name and signal an error if unable to }
  106.   {$I+}
  107.   try
  108.     TheDisplayBitmap.LoadFromFile( SetupDialog.TheImageFilename );
  109.   except
  110.     { abort on any io error at all! }
  111.     on E:EInOutError do
  112.     begin
  113.       { Signal the error condition }
  114.       ErrorDialog( SetupDialog.TheImageFileName + ' ' +
  115.        GetIOErrorMessage( E.ErrorCode ) + '! Aborting Saver!' );
  116.       { abort the saver }
  117.       exit;
  118.     end;
  119.   end;
  120.   { Get a Position where the image can move at least a little }
  121.   CurrentXLocation := Random(( Screen.Width - ( TheDisplayBitmap.Width * 2 ))) + 1;
  122.   CurrentYLocation := Random(( Screen.Height - ( TheDisplayBitmap.Height * 2 ))) + 1;
  123.   { Start out moving right and down }
  124.   CurrentDeltaX := CCSaverJumpIncrement;
  125.   CurrentDeltaY := CCSaverJumpIncrement;
  126.   { Create the two bitmaps to handle smooth animation }
  127.   TheSavedBackgroundBitmap := TBitmap.Create;
  128.   TheWorkspaceBitmap := TBitmap.Create;
  129.   { Set the bitmaps to appropriate height and width values }
  130.   TheWorkspaceBitmap.Width := Screen.Width;
  131.   TheWorkSpaceBitmap.Height := Screen.Height;
  132.   TheSavedBackgroundBitmap.Width := TheDisplayBitmap.Width;
  133.   TheSavedBackgroundBitmap.Height := TheDisplayBitmap.Height;
  134.   { Blank out the workspace's canvas }
  135.   with TheWorkspaceBitmap.Canvas do
  136.   begin
  137.     brush.color := clblack;
  138.     pen.color := clblack;
  139.     Brush.style := bsSolid;
  140.     Rectangle( 0 , 0 , Screen.Width , Screen.Height );
  141.   end;
  142.   { Put the background behind the saved bitmap into the save buffer }
  143.   TheSavedBackgroundBitmap.Canvas.Copyrect( Rect( 0 , 0 , TheDisplayBitmap.Width ,
  144.    TheDisplayBitmap.Height ) , TheWorkSpacebitmap.canvas , Rect( CurrentXLocation ,
  145.    CurrentYLocation , CurrentXLocation + TheDisplayBitmap.Width , CurrentYLocation +
  146.     TheDisplayBitmap.Height ));
  147.   { Put the image in the workspace }
  148.   TheWorkspaceBitmap.Canvas.Copyrect( Rect( CurrentXLocation , CurrentYLocation ,
  149.    CurrentXLocation + TheDisplayBitmap.Width , CurrentYLocation + TheDisplayBitmap.Height ) ,
  150.     TheDisplayBitmap.Canvas , Rect( 0 , 0 , TheDisplayBitmap.Width , TheDisplayBitmap.Height ));
  151.   { And blas it to the screen to start off }
  152.   CCScreenSaverForm.Canvas.CopyRect( Rect( CurrentXLocation , CurrentYLocation ,
  153.    CurrentXLocation + TheDisplayBitmap.Width , CurrentYLocation + TheDisplayBitmap.Height ) ,
  154.    TheWorkspaceBitmap.Canvas , Rect( CurrentXLocation , CurrentYLocation , CurrentXLocation +
  155.     TheDisplayBitmap.Width , CurrentYLocation + TheDisplayBitmap.Height ));
  156. end;
  157.  
  158. { Delphi wrote this; put in calls to unhook the message handler and turn off }
  159. { the timer and show the cursor again. Then free all the bitmaps.            }
  160. procedure TCCScreenSaverForm.FormHide(Sender: TObject);
  161. begin
  162.   { Set the message handler hook to nil to abort message processing }
  163.   Application.OnMessage := nil;
  164.   { Turn off the timer until needed again }
  165.   CCSSTimer.Enabled := false;
  166.   { Make an API call to turn on the cursor again }
  167.   ShowCursor( true );
  168.   { Free all the bitmaps till next time }
  169.   TheDisplayBitmap.Free;
  170.   TheSavedBackGroundBitmap.Free;
  171.   TheWorkspaceBitmap.Free;
  172. end;
  173.  
  174. { Delphi wrote this; use it to maximize the window to the whole screen }
  175. procedure TCCScreenSaverForm.FormActivate(Sender: TObject);
  176. begin
  177.   { Maximize to the whole screen }
  178.   WindowState := wsMaximized;
  179. end;
  180.  
  181. { Delphi wrote this; use it to actually move the bitmap around to clear }
  182. { the screen during the operation of the screen saver form              }
  183. procedure TCCScreenSaverForm.CCSSTImerTimer(Sender: TObject);
  184. var OldXLocation ,
  185.     OldYLocation   : Integer;
  186.     ComputedXLocation ,
  187.     ComputedYLocation : Integer;
  188. begin
  189.   { Move the bitmap along the chosen coordinate until it hits an edge }
  190.   with TheWorkSpaceBitmap.Canvas do
  191.   begin
  192.     {Erase bitmap by copying in saved background}
  193.     CopyMode := cmSrcCopy;
  194.     CopyRect( Rect( CurrentXLocation , CurrentYLocation , CurrentXLocation +
  195.      TheDisplayBitmap.Width, CurrentYLocation + TheDisplayBitmap.Height ) ,
  196.       TheSavedBackgroundBitmap.Canvas, Rect( 0 , 0 , TheDisplayBitmap.Width ,
  197.        TheDisplayBitmap.Height ));
  198.     OldXLocation := CurrentXLocation;
  199.     OldYLocation := CurrentYLocation;
  200.     { set new bitmap position}
  201.     { first increment the position by current counters }
  202.     CurrentXLocation := CurrentXLocation + CurrentDeltaX;
  203.     CurrentYLocation := CurrentYLocation + CurrentDeltaY;
  204.     { If at the right edge, move left and randomly set the up/down move }
  205.     if ( CurrentXLocation + TheDisplayBitmap.Width ) >= Screen.Width then
  206.     begin
  207.       CurrentDeltaX := -CCSaverJumpIncrement;
  208.       if Random( 10 ) > 7 then   { 3 out of ten times go either reverse or flat }
  209.       case CurrentDeltaY of
  210.         -CCSaverJumpIncrement : CurrentDeltaY := 0;
  211.          0                    : CurrentDeltaY := CCSaverJumpIncrement;
  212.          CCSaverJumpIncrement  : CurrentDeltaY := -CCSaverJumpIncrement;
  213.       end;
  214.     end;
  215.     { If at the bottom, move up and randomly set the right/left move }
  216.     if ( CurrentYLocation + TheDisplayBitmap.Height ) >= Screen.Height then
  217.     begin
  218.       CurrentDeltaY := -CCSaverJumpIncrement;
  219.       if Random( 10 ) > 7 then   { 3 out of ten times go either reverse or flat }
  220.       case CurrentDeltaX of
  221.         -CCSaverJumpIncrement : CurrentDeltaX := 0;
  222.          0                    : CurrentDeltaX := CCSaverJumpIncrement;
  223.          CCSaverJumpIncrement : CurrentDeltaX := -CCSaverJumpIncrement;
  224.       end;
  225.     end;
  226.     { If at the left move right and randomly set the up/down move }
  227.     if CurrentXLocation  <= 1 then
  228.     begin
  229.       CurrentDeltaX := CCSaverJumpIncrement;
  230.       if Random( 10 ) > 7 then   { 3 out of ten times go either reverse or flat }
  231.       case CurrentDeltaY of
  232.         -CCSaverJumpIncrement : CurrentDeltaY := 0;
  233.          0                    : CurrentDeltaY := CCSaverJumpIncrement;
  234.          CCSaverJumpIncrement : CurrentDeltaY := -CCSaverJumpIncrement;
  235.       end;
  236.     end;
  237.     { If at the top move down and randomly set the right/left move }
  238.     if CurrentYLocation <= 1 then
  239.     begin
  240.       CurrentDeltaY := CCSaverJumpIncrement;
  241.       if Random( 10 ) > 7 then    { 3 out of ten times go either reverse or flat }
  242.       case CurrentDeltaX of
  243.         -CCSaverJumpIncrement : CurrentDeltaX := 0;
  244.          0                    : CurrentDeltaX := CCSaverJumpIncrement;
  245.          CCSaverJumpIncrement : CurrentDeltaX := -CCSaverJumpIncrement;
  246.       end;
  247.     end;
  248.     {save background at new bitmap position}
  249.     TheSavedBackgroundBitmap.Canvas.CopyRect( Rect( 0 , 0 , TheDisplayBitmap.Width ,
  250.      TheDisplayBitmap.Height), TheWorkSpaceBitmap.Canvas, Rect( CurrentXLocation ,
  251.       CurrentYLocation , CurrentXLocation + TheDisplayBitmap.Width, CurrentYLocation +
  252.        TheDisplayBitmap.Height ));
  253.     {copy the bitmap into place}
  254.     CopyRect( Rect( CurrentXLocation , CurrentYLocation , CurrentXLocation +
  255.      TheDisplayBitmap.Width, CurrentYLocation + TheDisplayBitmap.Height ) ,
  256.       TheDisplayBitmap.Canvas, Rect( 0 , 0 , TheDisplayBitmap.Width ,
  257.        TheDisplayBitmap.Height ));
  258.   end;
  259.   {Now blast the finished image to the screen!}
  260.   with CCScreenSaverForm.Canvas do
  261.   begin
  262.     if CurrentXLocation < OldXLocation then
  263.      ComputedXLocation := CurrentXLocation else
  264.       ComputedXLocation := OldXLocation;
  265.     if CurrentYLocation < OldYLocation then
  266.      ComputedYLocation := CurrentYLocation else
  267.       ComputedYLocation := OldYLocation;
  268.     CopyRect( Rect( ComputedXLocation , ComputedYLocation , ComputedXLocation +
  269.      TheDisplayBitmap.Width + CCSaverJumpIncrement + 2, ComputedYLocation +
  270.       TheDisplayBitmap.Height + CCSaverJumpIncrement + 2 ) , TheWorkSpaceBitmap.Canvas,
  271.        Rect( ComputedXLocation , ComputedYLocation ,
  272.        ComputedXLocation + TheDisplayBitmap.Width + CCSaverJumpIncrement + 2,
  273.         ComputedYLocation + TheDisplayBitmap.Height + CCSaverJumpIncrement + 2));
  274.   end;
  275. end;
  276.  
  277. end.
  278.